perm filename CB.F4[SAT,LCS] blob
sn#496779 filedate 1981-07-22 generic text, type T, neo UTF8
SUBROUTINE CMBN
COMMON /RC/MCLEF(1)
COMMON /FL/NX,N,L,M,NM,J,NT
COMMON /SAV/JCLEF(10),KCLEF(10),NMLST(10)
DIMENSION IP(10),NMS(10),NF(500)
C USE FILE NAMES CLFX, DRAW1 AND DRAW2. 400 WD LIMIT PER FILE.
CC IF(N.EQ.'S')GO TO 103
102 TYPE 1
1 FORMAT(' TYPE OUTPUT FILE NAME ',$)
DO 122 K=1,10
IP(K)=0
122 NMS(K)=' '
CALL A5IN(NM)
IF(NM.EQ.'B'.OR.NM.EQ.'99')RETURN
IF(NM.NE.' ')GO TO 40
NM=LASTNM
TYPE 107,LASTNM
40 LASTNM=NM
IF(LOOKF(NM).EQ.0)GO TO 100
IF(N.NE.'C')GO TO 103
C FOR ADDING TO COMBINED FILE.
TYPE 101,NM
CALL A5IN(NX)
IF(NX.EQ.'N')GO TO 102
100 IF(N.EQ.'C')GO TO 104
CCCC TYPE 52
TYPE 109
CALL A5IN(NMLST)
IF(NMLST(1).EQ.' ')GO TO 102
JCLEF(1)=1
DO 1111 K=2,10
JCLEF(K)=0
1111 NMLST(K)=' '
CALL RDSAV(JCLEF,NMLST,MCLEF,NM,MCLEF,0)
RETURN
104 L=0
NX=1
I=0
30 L=L+1
TYPE 41
41 FORMAT(' TYPE FILE NAME ',$)
CALL A5IN(NW)
IF(NW.EQ.' ')GO TO 8
IF(LOOKF(NW))GO TO 51
TYPE 52
GO TO 30
52 FORMAT(' FILE NOT FOUND'/)
51 I=I+1
IP(L)=NX
NMS(I)=NW
CALL RDSAV(KCLEF,NMLST,K,NW,MCLEF(NX),-2)
NX=NX+K
IF(L.LT.10)GO TO 30
101 FORMAT(' WRITE OVER ',A5,'.DMD? Y OR N? ',$)
8 NX=NX-1
14 CALL RDSAV(IP,NMS,NX,NM,MCLEF,0)
L=NX
RETURN
1103 TYPE 1104,ID
1104 FORMAT(' FILE FULL -- SAVED AS ',A5)
L=1
NM=ID
NX=MCLEF(1)
GO TO 8
103 CALL RDSAV(IP,NMS,NX,NM,NF,-1)
107 FORMAT(1X,A5)
TYPE 109
109 FORMAT(' TYPE ID NAME (<CR>=BACKUP) -- ',$)
CALL A5IN(ID)
IF(ID.EQ.' ')GO TO 102
JD=0
L=0
CC NX=NX-1
DO 110 K=1,10
IF(NMS(K).EQ.ID)JD=K
IF(NMS(K).EQ.' ')GO TO 112
L=K
110 IF(JD.EQ.0.AND.K.EQ.10)GO TO 1103
112 IF(N.EQ.'Z')GO TO 127
C FOR DELETIONS
L=L+1
IF(JD.NE.0)GO TO 111
C ADDS ON TO END
N=0
IP(L)=NX+1
DO 113 K=NX+1,MCLEF(1)+NX
N=N+1
113 NF(K)=MCLEF(N)
NX=NX+N
NMS(L)=ID
L=L+1
114 DO 115 K=1,NX
115 MCLEF(K)=NF(K)
C MOVES IT ALL TO MCLEF
GO TO 14
127 MCLEF(1)=0
111 N=IP(JD)
NR=MCLEF(1)
M=NF(IP(JD))
NW=NR-M
NX=NX+NW
IF(NW)201,120,203
201 JA=N+NR
JB=NX
JC=1
GO TO 204
203 JA=NX
JB=N+NW
JC=-1
204 DO 121 K=JA,JB,JC
121 NF(K)=NF(K-NW)
IF(NR.EQ.0)GO TO 126
120 DO 117 K=1,NR
NF(N)=MCLEF(K)
117 N=N+1
CC L=L-1
IF(NW.EQ.0)GO TO 114
DO 119 K=JD+1,L
119 IP(K)=IP(K)+NW
C FIXES UP FIRST LINE.
CC123 L=L-1
CC NX=NX-1
GO TO 114
126 IP(L+1)=0
CC L=L-1
DO 124 K=JD,L-1
IP(K)=IP(K+1)+NW
124 NMS(K)=NMS(K+1)
NMS(L)=' '
GO TO 114
END
CC SUBROUTINE A5IN(N)
CC10 FORMAT(A5)
CC ACCEPT 10,N
CC CALL LO2UP(N)
CC END
SUBROUTINE RDSAV(KT,NMS,K,NAME,IO,L)
C POINTER LIST, NAME LIST, WDCNT, FILE NAME, DATA, RD OR WRT.
COMMON /RC/MCLEF(1) /FL/IC,NH,NQ,A,B,C,D
DIMENSION KT(1),NMS(1),IO(1),JALL(21)
IF(L)GO TO 5
C L=-1 FOR READER, -2=NO TYPE OF NAME LIST.
DO 1 N=1,10
JALL(N)=KT(N)
1 JALL(N+11)=NMS(N)
JALL(11)=K
TYPE 6,K
C THESE ROUTINES ARE IN 'MSSIO.FAI'
CALL PUTEXT(NAME,'DMD')
CALL EXTOUT(JALL,21)
CALL EXTOUT(IO,K+1)
CALL FINEXT
RETURN
5 CALL GETEXT(NAME,'DMD')
CALL EXTIN(JALL,21)
K=JALL(11)
TYPE 6,K
6 FORMAT(' TOTAL WDS=',I3,'/350')
CALL EXTIN(IO,K)
DO 2 N=1,10
KT(N)=JALL(N)
2 NMS(N)=JALL(N+11)
IF(L.EQ.-2)RETURN
TYPE 3
TYPE 4,(NMS(N),N=1,10)
3 FORMAT(
1' 0 1 2 3 4 5 6 7
1 8 9')
4 FORMAT(' IDENT. NAMES:'/,10(2XA5))
END